home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / apollot.lha / apollot_sr10 / tboot / boot_load.pas < prev    next >
Pascal/Delphi Source File  |  1990-07-23  |  21KB  |  786 lines
  1. PROGRAM boot_load;
  2.  
  3. %NOLIST;
  4.  
  5. %INCLUDE '/us/ins/ubase.ins.pas';
  6.  
  7. %INCLUDE '/sys/ins/time.ins.pas';
  8. %INCLUDE '/sys/ins/cal.ins.pas';
  9. %INCLUDE '/sys/ins/vfmt.ins.pas';
  10. %INCLUDE '/sys/ins/error.ins.pas';
  11. %INCLUDE '/sys/ins/pgm.ins.pas';
  12. %INCLUDE '/sys/ins/name.ins.pas';
  13.  
  14. { FROM /sys/ins/base.ins.pas - ??? }
  15.  
  16. CONST
  17.     ios_$max = 127;                     { [0..ios_$max] valid range for ios_$id_t when in use }
  18.  
  19. TYPE
  20.     ios_$id_t = 0..ios_$max;            { open stream identifier }
  21.  
  22.     ios_$seek_key_t = RECORD
  23.         rec_adr:  integer32;
  24.         byte_adr: integer32;
  25.         END;
  26.  
  27. { FROM /sys/ins/base.ins.pas - ??? }
  28.  
  29. %INCLUDE '/sys/ins/ios.ins.pas';
  30.  
  31. %INCLUDE '/us/ins/as.ins.pas';          { for as_$get_info }
  32. %INCLUDE '/us/ins/loader.ins.pas';      { for pm_$load, kg_$lookup }
  33. %INCLUDE '/us/ins/cl.ins.pas';          { for cl_$... }
  34. %INCLUDE '/us/ins/lib.ins.pas';         { for lib_$data_move }
  35. %INCLUDE '/us/ins/mst.ins.pas';         { for mst_$get_uid }
  36. %INCLUDE '/us/ins/file.ins.pas';        { for file_$create, file_$delete_when_unlocked }
  37. %INCLUDE '/us/ins/ms.ins.pas';          { for ms_$mapl_uid }
  38.  
  39. %LIST;
  40.  
  41. {*
  42. PROCEDURE ms_$mk_temporary(
  43.   in va: univ_ptr;
  44.   out status: status_$t
  45.   ); extern;
  46. *}
  47.  
  48. PROCEDURE relocate
  49.     ( count: linteger
  50.     ; relocs: univ_ptr
  51.     ; base: univ_ptr
  52.     ; at: univ_ptr
  53.     );
  54.     VAL_PARAM; EXTERN;
  55.  
  56.     { from /us/com/las/las.pas  }
  57.  
  58. CONST
  59.     machine_types = 8;
  60.  
  61. VAR
  62.     max_va: ARRAY [ -1..machine_types ] OF linteger
  63.        := [ 16#03D00000
  64.            , 16#00D00000
  65.            , 16#00D00000
  66.            , 16#00D00000
  67.            , 16#00D00000
  68.            , 16#0F800000
  69.            , 16#00D00000
  70.            , 16#78000000
  71.            , 0
  72.            , 16#03B00000
  73.          ];
  74.  
  75. CONST
  76.     hdr_size = 32;      { Bad news:  assumption about the amount of crud at
  77.                           the top of UASC files }
  78.  
  79. VAR
  80.     debug: boolean;
  81.     verbose: boolean;
  82.     use_streams: boolean;
  83.     timing: boolean;
  84.     times: ARRAY[1..20] OF time_$clock_t;
  85.     time_nest: pinteger := 0;
  86.  
  87.  
  88. PROCEDURE start_timing;
  89.  
  90. BEGIN
  91.     IF NOT timing THEN
  92.         RETURN;
  93.  
  94.     time_nest := time_nest + 1;
  95.     time_$clock( times[ time_nest ] );
  96.     END;
  97.  
  98.  
  99. PROCEDURE stop_timing
  100.     ( IN  s: string
  101.     );
  102.  
  103. VAR
  104.     t: time_$clock_t;
  105.     tf: double;                                   
  106.     db: boolean;
  107.  
  108. BEGIN   
  109.     IF NOT timing THEN
  110.         RETURN;
  111.  
  112.     time_$clock( t );
  113.     db := cal_$sub_clock( t, times[ time_nest ] ) ;
  114.     cal_$float_clock( t, tf );
  115.     vfmt_$write2( s, 0, 0 );
  116.     vfmt_$write2( ' = %f%.', tf, 0 );
  117.  
  118.     time_nest := time_nest - 1;
  119.  
  120.     END;
  121.  
  122.  
  123. PROCEDURE die
  124.     ( IN str: string
  125.     ; IN st: UNIV status_$t
  126.     );
  127.  
  128. BEGIN
  129.     vfmt_$write2( 'error loading t: %$', 0, 0 );
  130.     vfmt_$write2( str, 0, 0 );
  131.     vfmt_$write2( ' - %.', 0, 0 );
  132.     error_$print( st );
  133.     pgm_$exit();
  134.     END;
  135.  
  136.  
  137. FUNCTION crtemp
  138.     ( IN len: linteger
  139.     ; OUT st: status_$t
  140.     )
  141.     : univ_ptr;
  142.  
  143. VAR
  144.     maplen: linteger;
  145.     p: univ_ptr;
  146.     xst: status_$t;
  147.     uid: uid_$t;
  148.  
  149. BEGIN
  150.     file_$create( uid_$nil, uid, st );
  151.  
  152.     p := ms_$mapl_uid( uid, 0, len, ms_$nr_xor_1w, ms_$wrx, true, maplen, st );
  153.  
  154.     file_$delete_when_unlocked( uid, xst );
  155.  
  156.     crtemp := p;   
  157.     END;
  158.  
  159. {
  160.     T object file format:
  161.      header
  162.        entry (relative offset in data section)
  163.        bytes of text relocation (each item is a four byte address to be relocated)
  164.        bytes of data relocation                      "
  165.        bytes of foreign relocation (each item is a four byte address followed by
  166.                                 a two byte size followed by characters)
  167.        size of text section (bytes)
  168.        size of data section (bytes)
  169.      text section
  170.      data section
  171.      text relocations
  172.      data relocations
  173.      xeno relocations
  174. }
  175.  
  176. PROCEDURE load_t_object_file
  177.     ( IN t_name:  string
  178.     ; IN t_namel: integer16
  179.     ; OUT start_address: univ_ptr
  180.     ; OUT data_address: univ_ptr
  181.     );
  182.  
  183.     TYPE
  184.         memarray_t =
  185.             ARRAY [ 0 .. 1000000 ] OF linteger;
  186.         p_memarray_t  =
  187.             ^ memarray_t;
  188.  
  189.         xeno_item_t =
  190.             RECORD
  191.             addr:  linteger;
  192.             name:  PACKED ARRAY [ 1..32 ] OF char;  { blank padded, too! }
  193.  
  194.             END;
  195.  
  196.         p_xeno_item_t =
  197.             ^ xeno_item_t;
  198.  
  199.         header_t =
  200.             RECORD
  201.             entry:           linteger;
  202.             text_reloc_size: linteger;
  203.             data_reloc_size: linteger;
  204.             foreign_size:    linteger;
  205.             text_size:       linteger;
  206.             data_size:       linteger;
  207.             END;
  208.  
  209.     VAR
  210.         header:    header_t;
  211.         header_p: ^header_t;
  212.  
  213.         d_at     : ^string;
  214.  
  215.         st:    status_$t;
  216.  
  217.         d_p,
  218.         t_p,
  219.         t_at,
  220.         r_at     : univ_ptr;
  221.  
  222.         len,
  223.         t_maplen,
  224.         r_maplen : linteger;
  225.  
  226.         t_relocs,
  227.         d_relocs,
  228.         data_p      : p_memarray_t;
  229.  
  230.         xeno_p      : p_xeno_item_t;
  231.         xeno_limit  : linteger;
  232.  
  233.         t_item_count,
  234.         d_item_count: linteger;
  235.  
  236.         i,
  237.         ds_index    : linteger;
  238.  
  239.         relocation_size,
  240.         relocation_offset: linteger;
  241.  
  242.         global_address: linteger;
  243.  
  244.         id          : ios_$id_t;
  245.  
  246. BEGIN
  247.     start_timing();
  248.  
  249.         { open object file }
  250.  
  251.         { use_streams vs. not:  The logically correct way to copy the
  252.           impure data from the object file is via Streams.  
  253.  
  254.           Not only that, at sr9.5 it turns out to be better to slog the
  255.           data in via Streams, rather than by mapping the whole file
  256.           and doing one mongo data copy.  This is because the latter
  257.           will result in more good pages being tossed from memory.  Streams
  258.           does a piecewise copy -- mapping and copying piece of the file.
  259.           This will result in a minimal number of good pages pages being
  260.           tossed.
  261.  
  262.           Unfortunately, due to a misfeature in Streams, the fact that
  263.           a "seek" occurs on the stream (to position to the impure data)
  264.           causes Streams to think that the file is being accessed
  265.           non-sequentially.  As a result, Streams backs off some memory
  266.           management optimization (specifically "touch ahead") to something
  267.           less than the max value.
  268.  
  269.           In the end, I couldn't decide whether the Streams or non-Streams
  270.           approach was better, so I left in both mechanisms.  If/when
  271.           the Streams misfeature is fixed, "use_streams" mode should
  272.           be the only one, and the mapping code should be flushed from
  273.           here. }
  274.  
  275.     IF use_streams THEN BEGIN
  276.         id := ios_$open( t_name, t_namel, [], st );
  277.         IF st.all <> 0 THEN
  278.             die( 'opening object file%$', st );
  279.  
  280.         len := ios_$get( id, [ios_$no_rec_bndry_opt], header, sizeof( header ), st );
  281.         END
  282.     ELSE BEGIN
  283.         header_p := ms_$mapl( t_name, t_namel, hdr_size + 0, sizeof( header ), ms_$nr_xor_1w, ms_$rx
  284.                             , false, len, st );
  285.         IF st.all <> 0 THEN
  286.             die( 'opening object file%$', st );
  287.  
  288.             { Copy header... }
  289.  
  290.         ms_$advice( header_p, sizeof( header ), ms_$random, [], 0, st );
  291.         header := header_p^;
  292.         END;
  293.  
  294.     IF verbose THEN
  295.         WITH header DO BEGIN
  296.             vfmt_$write5( ';Text = %d, data = %d, text reloc = %d, data reloc = %d%.',
  297.                           text_size, data_size, text_reloc_size, data_reloc_size, 0 );
  298.             vfmt_$write2( ';Foreign_reloc_size = %d, entry = %LH%.',
  299.                           foreign_size, entry );
  300.         END;
  301.  
  302.         { create map data section file }
  303.  
  304.     d_at := crtemp( header.data_size, st );
  305.     IF st.all <> 0 THEN
  306.         die( 'creating/mapping data section temporary file%$', st );
  307.  
  308.     ms_$advice( d_at, header.data_size, ms_$sequential, [], 0, st );
  309.  
  310.         { seek to data section }
  311.  
  312.     IF use_streams THEN BEGIN
  313.         ios_$seek( id, ios_$absolute, ios_$byte_seek, sizeof( header ) + header.text_size, st );
  314.  
  315.         start_timing();
  316.         len := ios_$get( id, [ios_$no_rec_bndry_opt], d_at^, header.data_size, st );
  317.         stop_timing( ';Time to copy data section%$' );
  318.     
  319.         ios_$close( id, st );
  320.  
  321.             { map text section of object file }
  322.     
  323.         t_at := ms_$mapl( t_name, t_namel, hdr_size + sizeof( header ), header.text_size, ms_$nr_xor_1w, ms_$rx
  324.                             , false, len, st );    
  325.         END
  326.     ELSE BEGIN
  327.         d_p := ms_$remap( header_p, hdr_size + sizeof( header ) + header.text_size, header.data_size, len, st );
  328.     
  329.         IF st.all <> 0 THEN
  330.             die( 'seeking for data section%$', st );
  331.     
  332.             { ... and copy data section into mapped temporary file }
  333.     
  334.         ms_$advice( d_p,  header.data_size, ms_$sequential, [], 0, st );
  335.     
  336.         start_timing();
  337.         lib_$data_move( d_p, d_at, header.data_size );
  338.         stop_timing( ';Time to copy data section%$' );
  339.  
  340.             { map text section of object file }
  341.  
  342.         t_at := ms_$remap( d_p, hdr_size + sizeof( header ), header.text_size, t_maplen, st );
  343.  
  344.         IF verbose OR debug THEN
  345.             vfmt_$write2( ';Text section_at: %LH%.', t_at, 0 );
  346.  
  347.         END;
  348.     
  349.     IF st.all <> 0 THEN
  350.         die( 'mapping procedure section%$', st );
  351.  
  352.     IF debug THEN
  353.     BEGIN
  354.             { read in text section }
  355.  
  356.         t_p := t_at;
  357.  
  358.         t_at := crtemp( header.text_size, st );
  359.         IF st.all <> 0 THEN
  360.             die( 'mapping writable text section temporary file%$', st );
  361.  
  362.         lib_$data_move( t_p, t_at, header.text_size );
  363.  
  364.         ms_$unmap( t_p, header.text_size, st );
  365.         END;
  366.  
  367.         { mark the pure text access pattern as being "random" }
  368.  
  369.     ms_$advice( t_at, header.text_size, ms_$random, [], 0, st );
  370.  
  371.         { number of bytes of relocation information }
  372.  
  373.     relocation_size := header.text_reloc_size
  374.                        + header.data_reloc_size
  375.                        + header.foreign_size;
  376.  
  377.         { offset from beginning of file to relocation information }
  378.  
  379.     relocation_offset := sizeof( header ) + header.text_size + header.data_size;
  380.  
  381.         { map relocation information }
  382.  
  383.     r_at := ms_$mapl( t_name, t_namel, hdr_size + relocation_offset, relocation_size
  384.                     , ms_$nr_xor_1w, ms_$r, false, r_maplen, st );
  385.  
  386.     IF verbose OR debug THEN
  387.         vfmt_$write2( 'relocation_size = %d%.',
  388.                       relocation_size, 0 );
  389.  
  390.     IF st.all <> 0 THEN
  391.         die( 'mapping relocation information%$', st );
  392.  
  393.         { t_items are offsets in the data section where the address of
  394.           the text section must be added; analogously for d_items }
  395.  
  396.     t_item_count := header.text_reloc_size DIV 4;
  397.     d_item_count := header.data_reloc_size DIV 4;
  398.  
  399.     t_relocs := p_memarray_t( r_at );
  400.     d_relocs := p_memarray_t( linteger( r_at ) + header.text_reloc_size );
  401.     data_p   := p_memarray_t( d_at ); { pointer to beginning of data section }
  402.         
  403.             { for each addr in t_reloc (d+addr) <- (d+addr) + t }
  404.     
  405.     start_timing();
  406.     relocate( t_item_count, t_relocs, data_p, t_at );
  407.     stop_timing( ';Text relocation time%$' );
  408.     
  409.             { for each addr in d_reloc (d+addr) <- (d+addr) + d }
  410.     
  411.     start_timing();
  412.     relocate( d_item_count, d_relocs, data_p, d_at );
  413.     stop_timing( ';Data relocation time%$' );
  414.         
  415.         { for each addr, name in f_reloc (d+addr) <- lookup(name) }
  416.     
  417.     IF verbose OR debug THEN
  418.         vfmt_$write2( 'relocation_size = %d%.',
  419.                       relocation_size, 0 );
  420.  
  421.     xeno_p := p_xeno_item_t( linteger( d_relocs ) + header.data_reloc_size );
  422.     xeno_limit := linteger( r_at ) + relocation_size;
  423.  
  424.     IF verbose OR debug THEN
  425.         vfmt_$write2( ';Foreign relocs at: (%LH, %LH)%.', xeno_p, xeno_limit );
  426.     IF verbose OR debug THEN
  427.         vfmt_$write2( ';r_at = %LH, relocation_size = %d%.',
  428.                       r_at, relocation_size );
  429.  
  430.     start_timing();
  431.  
  432.     WHILE linteger( xeno_p ) < xeno_limit DO BEGIN
  433.  
  434.         ds_index := xeno_p^.addr DIV 4;
  435.         global_address := linteger( kg_$lookup( xeno_p^.name ) );
  436.         data_p^[ds_index] := global_address;
  437.  
  438.         IF global_address = 0 THEN
  439.             vfmt_$write2( ';Warning: global %A not found%.', xeno_p^.name, 32 );
  440.  
  441.         xeno_p := p_xeno_item_t( linteger( xeno_p ) + sizeof( xeno_item_t ) );
  442.         END;
  443.  
  444.     stop_timing( ';Foreign relocation time%$' );
  445.  
  446.     start_address := univ_ptr( header.entry + linteger( d_at ) );
  447.     data_address := d_at;
  448.  
  449.     IF verbose OR debug THEN
  450.         vfmt_$write2( ';Data section_at: %LH%.', d_at, 0 );
  451.  
  452.     ms_$advice( d_at, header.data_size, ms_$random, [], 0, st );
  453.  
  454.     stop_timing( ';Load time%$' );
  455.     END;
  456.  
  457.     { ------------------------------------------------------- Heap allocation }
  458.  
  459.  
  460.  
  461.     { the following use of unreleased stuff is only to determine the biggest
  462.   hole in the address space, so we have the freedom to allocate heaps
  463.   as big as that.  I think this stuff is all localized to BIGGEST_HOLE and
  464.   MACHINE_VAS }
  465.  
  466.  
  467. FUNCTION machine_vas
  468.    : linteger;
  469.  
  470.     TYPE
  471.         { from /us/ins/md_if.ins.pas }
  472.  
  473.         aux_info_t =
  474.             SET OF
  475.                 ( crash_eps                  { bit 0 => log_error, crash eps exist }
  476.  
  477.                 , m68020_board
  478.                 );              { bit 1 => M68020 }
  479.  
  480.  
  481.             { from /us/ins/asknode.ins.pas }
  482.  
  483.         asknode_$reply_t =
  484.             RECORD
  485.             version: pinteger;
  486.             kind   : integer16;
  487.             status : status_$t;
  488.             CASE integer OF
  489.             0: (
  490.                 config_valid_cnt: integer;
  491.                 config_mach_id:   integer;
  492.                 config_aux_info:  aux_info_t;
  493.                 );
  494.             1: (
  495.                 foo: ARRAY [ 1..25 ] OF integer;
  496.                 );
  497.             END;
  498.  
  499.     PROCEDURE asknode_$info
  500.         ( IN kind: integer16
  501.         ; IN x
  502.         , y: linteger
  503.         ; OUT reply: asknode_$reply_t
  504.         ; OUT status: status_$t
  505.         );
  506.         EXTERN;
  507.  
  508.     VAR
  509.         status: status_$t;
  510.         reply: asknode_$reply_t;
  511.  
  512.             { from /sources/us/com/las/las.pas  }
  513.  
  514.         my_machine: integer;
  515.  
  516. BEGIN
  517.     asknode_$info( 39, 0, 0, reply, status );
  518.  
  519.     IF status.all <> status_$ok THEN
  520.         my_machine := 1
  521.     ELSE
  522.         my_machine := reply.config_mach_id;
  523.  
  524.     IF my_machine > machine_types THEN
  525.     BEGIN
  526.         vfmt_$write2( '%;Unknown machine type: %WD%.', my_machine, 0 );
  527.         my_machine := 1;
  528.         END;
  529.  
  530.     IF my_machine IN [ 2, 3, 5 ] AND THEN
  531.        m68020_board IN reply.config_aux_info
  532.     THEN
  533.         my_machine := -1;
  534.  
  535.     machine_vas := max_va[my_machine];
  536.  
  537.     END;
  538.  
  539.     { scan address space to find biggest hole }
  540.  
  541. FUNCTION biggest_hole
  542.    : integer;
  543.  
  544.     VAR
  545.         muid: uid_$t;
  546.         va,
  547.         start: linteger;
  548.         status: status_$t;
  549.         total,
  550.         max: integer;
  551.         max_va: linteger;
  552.  
  553. BEGIN
  554.     max_va := machine_vas();
  555.     va := 0;
  556.     max := 0;
  557.     total := 0;
  558.  
  559.     WHILE va < max_va DO
  560.     BEGIN
  561.         mst_$get_uid( va, muid, start, status );
  562.  
  563.         IF status.all <> 0 THEN
  564.             total := total + 1 
  565.         ELSE
  566.         BEGIN
  567.             IF total > max THEN
  568.                 max := total;
  569.             total := 0;
  570.             END;
  571.  
  572.         va := va + seg_size;
  573.         END;
  574.  
  575.     IF total > max THEN
  576.         max := total;
  577.  
  578.     biggest_hole := max;
  579.     END;
  580.  
  581.  
  582. PROCEDURE compute_heap_size
  583.     ( heap_wanted
  584.     , leave_wanted: linteger
  585.     ; heap_wanted_given
  586.     , leave_wanted_given: boolean
  587.     ; OUT heap_size: linteger
  588.     );
  589.  
  590.     CONST
  591.         min_heap_size     = 16#80000;  { 512K }
  592.         default_heap_size = 16#400000; { 4Mb }
  593.         minimum_leave     = 16#80000;  { 512K - to leave free after heap alloc }
  594.  
  595.     VAR
  596.         max:      linteger;
  597.         status:   status_$t;
  598.         max_heap_size:  linteger; { choosing heap size }
  599.         space_to_leave: linteger;
  600.         i: integer;               { iteration }
  601.  
  602.  
  603. BEGIN
  604.  
  605.     IF leave_wanted_given THEN
  606.         space_to_leave := leave_wanted
  607.     ELSE
  608.         space_to_leave := minimum_leave + leave_wanted;
  609.  
  610.     max := biggest_hole();      { maximum possible heap size }
  611.  
  612.     max_heap_size := ((lshft( max, 15 ) - space_to_leave) DIV 2) & 16#FFFF8000;  { 32k align }
  613.  
  614.     IF (max_heap_size < min_heap_size) THEN
  615.     BEGIN
  616.         vfmt_$write2( 'Not enough space to allocate minimum heaps%.', 0 , 0 );
  617.         pgm_$exit;
  618.         END;
  619.  
  620.         { pick a heap size }
  621.  
  622.     IF (NOT heap_wanted_given) THEN
  623.         IF default_heap_size < max_heap_size THEN
  624.             heap_size := default_heap_size
  625.         ELSE
  626.             heap_size := max_heap_size
  627.     ELSE
  628.     BEGIN
  629.         IF heap_wanted = 0 THEN
  630.             heap_wanted := max_heap_size;
  631.  
  632.         heap_wanted := (heap_wanted + 16#7FFF) & 16#FFFF8000;  { 32k align }
  633.  
  634.         IF (heap_wanted > max_heap_size) THEN
  635.         BEGIN
  636.             vfmt_$write2( ';Heap allocated smaller than requested.%.', 0, 0 );
  637.             heap_size := max_heap_size;
  638.             END
  639.         ELSE IF (heap_wanted < min_heap_size) THEN
  640.         BEGIN
  641.             vfmt_$write2( ';Heap allocated larger than requested.%.', 0, 0 );
  642.             heap_size := min_heap_size;
  643.             END
  644.         ELSE
  645.             heap_size := heap_wanted;
  646.         END;
  647.  
  648.         { report size chosen }
  649.  
  650.     IF heap_wanted_given OR leave_wanted_given THEN
  651.         vfmt_$write2( ';%LD bytes per heap, %LD bytes reserved%.'
  652.                     , heap_size, space_to_leave );
  653.  
  654.     END;
  655.  
  656.  
  657.     { --------------------------------------------------------------------------- }
  658.  
  659.  
  660.     { assembly code to do the jump to a random address }
  661.  
  662. PROCEDURE jump_to_t
  663.     ( IN    start_address:         univ_ptr
  664.     ; data_address:          univ_ptr
  665.     ; sfh_xenoid_dummy_slot: linteger
  666.     ; stack_low:             univ_ptr
  667.     ; guard1
  668.     , guard2:        univ_ptr
  669.     ; p1:                    name_$pname_t
  670.     ; lp1:                   linteger
  671.     ; at1:                   univ_ptr
  672.     ; p2:                    name_$pname_t
  673.     ; lp2:                   linteger
  674.     ; at2:                   univ_ptr
  675.     ; heap_size:             linteger
  676.     ; debug:                 boolean
  677.     );
  678.     VAL_PARAM; EXTERN;
  679.  
  680. PROCEDURE start_t;
  681.  
  682.     CONST
  683.         float_file = '~/tsystem/float.bin';
  684.  
  685.     VAR
  686.             { command line processing }
  687.  
  688.         t_name: string;
  689.         t_namel: integer16;
  690.  
  691.         cnt: integer;
  692.         heap_wanted, leave_wanted: linteger;
  693.         heap_p,
  694.         leave_p: boolean;
  695.  
  696.             { returned from loading t image }
  697.  
  698.         start_address: univ_ptr;
  699.         data_address: univ_ptr;
  700.  
  701.             { heap allocation }
  702.  
  703.         heap_size: linteger;
  704.         at1, at2: univ_ptr;
  705.  
  706.         st: status_$t;
  707.  
  708.             { as inquiry }
  709.  
  710.         dummy: integer;
  711.         as: as_$info_rec_t;
  712.  
  713.             { for pm_$load }
  714.  
  715.         info: pm_$load_info;
  716.  
  717. BEGIN
  718.     cl_$init( [], 'bl', 2 );
  719.  
  720.     debug       := cl_$get_flag( '-d[ebug]', cnt );
  721.     verbose     := cl_$get_flag( '-v[erbose]', cnt );
  722.     timing      := cl_$get_flag( '-time[]', cnt );
  723.     use_streams := cl_$get_flag( '-streams[]', cnt );
  724.  
  725.     heap_wanted := 0;
  726.     IF cl_$get_flag( '-h[eap]', cnt ) THEN
  727.     BEGIN
  728.         heap_p := true;
  729.         IF (cnt = 1) AND THEN (NOT cl_$get_num( heap_wanted )) THEN
  730.             heap_wanted := 0;
  731.         END
  732.     ELSE
  733.         heap_p := false;
  734.  
  735.     leave_wanted := 0;
  736.     IF cl_$get_flag( '-l[eave]', cnt ) THEN
  737.     BEGIN
  738.         leave_p := true;
  739.         IF (cnt = 1) AND THEN (NOT cl_$get_num( leave_wanted )) THEN
  740.             leave_wanted := 0;
  741.         END
  742.     ELSE
  743.         leave_p := false;
  744.  
  745.     IF NOT cl_$get_arg( cl_$first, t_name, t_namel, sizeof( string ) ) THEN
  746.         vfmt_$write2( 'Expecting T object file name%.', 0, 0 );
  747.  
  748.     pm_$load( float_file, sizeof( float_file ), [pm_$install], 0, info, st );
  749.     IF st.all <> 0 THEN
  750.         die( 'installing floating point%$', st );
  751.  
  752.            { relocate t object file }
  753.  
  754.     load_t_object_file( t_name, t_namel, start_address, data_address );
  755.  
  756.            { allocate heaps }
  757.  
  758.     compute_heap_size( heap_wanted, leave_wanted, heap_p, leave_p, heap_size );
  759.  
  760.     at1 := crtemp( heap_size, st );
  761.     IF st.all <> 0 THEN
  762.         die( 'creating/mapping first heap%$', st );
  763.  
  764.     at2 := crtemp( heap_size, st );
  765.     IF st.all <> 0 THEN
  766.         die( 'creating/mapping first heap%$', st );
  767.  
  768.     as_$get_info( as, sizeof( as ), dummy {actual size} );
  769.  
  770.     vfmt_$write2( 'Jumping to t...%', 0, 0 );
  771.  
  772.     jump_to_t( start_address
  773.              , data_address
  774.              , 0
  775.              , as.stack_low, as.guard1, as.guard2
  776.              , '', 0, at1                               { ++++  flush it}
  777.              , '', 0, at2                               { ++++  flush it}
  778.              , heap_size
  779.              , debug );
  780.  
  781.     END;
  782.  
  783. BEGIN
  784.     start_t();
  785.     END.
  786.